﻿Option Explicit On

Imports System
Imports System.Data.SQLite

Public Class clsRecordSet
    ''' <summary>
    ''' Classe para uso de INSERT/UPDATE semelhante aos do RecordSet
    ''' </summary>
    ''' <remarks>Rev. 30/12/2011 as 18:57</remarks>
    Public Class RecordSet
        Private myConnection As New SQLiteConnection()
        Private myDA As New SQLiteDataAdapter()
        Private myDS As New DataSet()
        Private myDT As DataTable
        '--
        Private blnInsert, blnCloned As Boolean
        Private intFields As Int16
        Private arrFields As New ArrayList
        Private intRowsAffected As Integer
        '--
        Public QueryString As String
        Public TableName As String
        Public WhereUsed As String
        Public CommandExecuted As String
        Public EOF As Boolean
        Public BOF As Boolean
        ''' <summary>
        ''' Retorna a quantidade de linhas afetadas pelo comando
        ''' </summary>
        ''' <value></value>
        ''' <returns></returns>
        ''' <remarks></remarks>
        Public ReadOnly Property RowsAffected() As Integer
            Get
                Return intRowsAffected
            End Get
        End Property
        ''' <summary>
        ''' Retorna ou insere o valor no campo do recordset
        ''' </summary>
        ''' <param name="FieldName"></param>
        ''' <value></value>
        ''' <returns></returns>
        ''' <remarks></remarks>
        Public Property Field(ByVal FieldName As String) As Object
            Get
                Return GetFieldValue(FieldName)
            End Get
            Set(ByVal value As Object)
                Call SetFieldValue(FieldName, value)
            End Set
        End Property
        ''' <summary>
        ''' Seta o novo valor no recordset
        ''' </summary>
        ''' <param name="FieldName"></param>
        ''' <param name="Value"></param>
        ''' <remarks></remarks>
        Private Sub SetFieldValue(ByVal FieldName As String, ByVal Value As Object)
            Call VerificaExistencia(FieldName)
            Dim intCount As Int16
            Dim myValue As Object = String.Empty
            For intCount = 0 To arrFields.Count - 1
                If arrFields(intCount)(0) = FieldName Then
                    If Not (Value Is DBNull.Value) Then
                        Select Case arrFields(intCount)(1)
                            Case "System.Int16", "System.Int32", "System.Int64", "System.UInt16", "System.UInt32", "System.UInt64"
                                myValue = CLng(Value)
                            Case "System.Single"
                                myValue = CSng(Value)
                            Case "System.Decimal"
                                myValue = CDec(Value)
                            Case "System.Double"
                                myValue = CDbl(Value)
                            Case "System.DateTime"
                                myValue = CDate(Value)
                            Case "System.String"
                                myValue = CStr(Value)
                            Case Else
                                myValue = Value
                        End Select
                    Else
                        myValue = Value
                    End If
                    arrFields(intCount)(5) = True
                    arrFields(intCount)(6) = myValue
                    Exit For
                End If
            Next
        End Sub
        ''' <summary>
        ''' Pega o valor do campo do recordset
        ''' </summary>
        ''' <param name="FieldName"></param>
        ''' <returns></returns>
        ''' <remarks></remarks>
        Private Function GetFieldValue(ByVal FieldName As String) As Object
            Call VerificaExistencia(FieldName)
            Dim intCount As Int16
            Dim myValue As Object = DBNull.Value
            For intCount = 0 To arrFields.Count - 1
                If arrFields(intCount)(0) = FieldName Then
                    myValue = arrFields(intCount)(6)
                End If
            Next
            Return myValue
        End Function
        ''' <summary>
        ''' Verifica se existe campo mencionado para insert ou update
        ''' </summary>
        ''' <param name="FieldName"></param>
        ''' <remarks></remarks>
        Private Sub VerificaExistencia(ByVal FieldName As String)
            Dim intCount As Int16
            Dim myValue As Object = DBNull.Value
            For intCount = 0 To arrFields.Count - 1
                If arrFields(intCount)(0) = FieldName Then
                    Exit Sub
                End If
            Next
            Throw New Exception("Campo [" & Me.TableName & "." & FieldName & "] não existe na tabela.")
        End Sub
        ''' <summary>
        ''' Executa comando direto, ex: INSERT INTO, UPDATE SET, DELETE FROM
        ''' </summary>
        ''' <param name="Query">Query de execução</param>
        ''' <remarks></remarks>
        Public Sub Execute(ByVal Query As String)
            Try
                '--
                Dim myCA As New SQLiteCommand(Query, myConnection)
                intRowsAffected = myCA.ExecuteNonQuery()
                'myCA.ExecuteScalar()
            Catch exc As SQLiteException
                Throw New Exception(exc.Message)
            End Try
        End Sub
        ''' <summary>
        ''' Executa comando direto, ex: INSERT INTO, UPDATE SET, DELETE FROM
        ''' </summary>
        ''' <param name="Query">Query de execução</param>
        ''' <returns></returns>
        ''' <remarks></remarks>
        Public Function ExecuteReturn(ByVal Query As String) As Object
            Try
                Dim myCA As New SQLiteCommand(Query, myConnection)
                Return myCA.ExecuteScalar()
            Catch exc As SQLiteException
                Throw New Exception(exc.Message & vbCrLf & Query)
            End Try
        End Function
        ''' <summary>
        ''' Abre conexão com a base de dados, use sempre o .Close() ao terminar
        ''' </summary>
        ''' <param name="ConnectionString">String de conexão da base de dados</param>
        ''' <remarks></remarks>
        Public Sub Open(ByVal ConnectionString As String, ByVal Password As String)
            Select Case myConnection.State
                Case ConnectionState.Executing
                Case ConnectionState.Open
                Case ConnectionState.Closed
                    myConnection.ConnectionString = ConnectionString
                    myConnection.SetPassword(Password)
                    myConnection.Open()
                Case Else

            End Select
        End Sub
        ''' <summary>
        ''' Abre a consulta com a base de dados para atualização dos dados
        ''' </summary>
        ''' <param name="Query">Query de consulta</param>
        ''' <remarks></remarks>
        Public Sub Query(ByVal Query As String)
            Try
                Me.QueryString = Query.Replace("  ", " ")
                TableName = GetTableName()
                WhereUsed = GetWhereUsed()
                '--
                myDA = New SQLiteDataAdapter(Me.QueryString, myConnection)
                '--
                myDS = New DataSet(Me.TableName)
                '--
                myDA.FillSchema(myDS, SchemaType.Source, Me.TableName)
                myDA.Fill(myDS, Me.TableName)
                '--
                myDT = myDS.Tables(TableName)

                Dim dc As DataColumn

                Me.BOF = IIf(myDT.Rows.Count > 0, False, True)
                Me.EOF = IIf(myDT.Rows.Count > 0, False, True)
                '-- Limpando dados em memoria dos campos
                arrFields.Clear()
                '--
                For Each dc In myDT.Columns
                    Dim fldName As String = dc.ColumnName                     '0
                    Dim fldType As String = dc.DataType.ToString              '1
                    Dim fldAutoInc As Boolean = dc.AutoIncrement              '2
                    Dim fldAllowNull As Boolean = dc.AllowDBNull              '3
                    Dim fldIsUnique As Boolean = dc.Unique                    '4
                    Dim fldChangedValue As Boolean = False                    '5
                    Dim fldValue As Object = DBNull.Value                     '6
                    '--
                    If myDT.Rows.Count > 0 Then
                        If Not (myDT.Rows(0).Item(fldName) Is DBNull.Value) Then
                            fldValue = myDT.Rows(0).Item(fldName)
                        End If
                    End If
                    '--
                    Dim myArray As Object() = {fldName, fldType, fldAutoInc, fldAllowNull, fldIsUnique, fldChangedValue, fldValue}
                    arrFields.Add(myArray)
                Next dc
            Catch exc As SQLiteException
                Throw New Exception(exc.Message)
            Finally

            End Try
        End Sub
        ''' <summary>
        ''' Retorna a consulta em um DataTable
        ''' </summary>
        ''' <param name="Query">Query de consulta</param>
        ''' <returns></returns>
        ''' <remarks>3.4.3.26</remarks>
        Public Function QueryDataTable(ByVal Query As String) As DataTable
            Try
                Dim myDR As SQLiteDataReader
                Dim myCMD As New SQLiteCommand()
                '--
                myCMD.Connection = myConnection
                myCMD.CommandText = Query
                '--
                myDR = myCMD.ExecuteReader()
                myDA = New SQLiteDataAdapter(Query, myConnection)
                '--
                myDS = New DataSet(0)
                '--
                myDA.FillSchema(myDS, SchemaType.Source, 0)
                myDA.Fill(myDS, 0)
                '--
                Me.BOF = IIf(myDS.Tables(0).Rows.Count > 0, False, True)
                Me.EOF = IIf(myDS.Tables(0).Rows.Count > 0, False, True)
                '--
                Return myDS.Tables(0)
            Catch ex As Exception
                Throw New Exception(ex.Message & vbCrLf & Query)
            End Try
        End Function
        ''' <summary>
        ''' Fecha a coexão com o recordset
        ''' </summary>
        ''' <remarks></remarks>
        Public Sub Close()
            If myConnection IsNot Nothing AndAlso myConnection.State <> System.Data.ConnectionState.Closed Then
                myConnection.Close()
            End If
            myConnection = Nothing
            blnInsert = False
            arrFields.Clear()
            blnCloned = False

            Me.QueryString = Nothing
            Me.TableName = Nothing
            Me.WhereUsed = Nothing
            Me.BOF = Nothing
            Me.EOF = Nothing
        End Sub
        ''' <summary>
        ''' Rertorna a chave primária
        ''' </summary>
        ''' <remarks>Somente para PostgreSQL</remarks>
        Private Sub GetPrimaryKeys()

        End Sub
        ''' <summary>
        ''' Retorna nome da tabela na consulta
        ''' </summary>
        ''' <returns></returns>
        ''' <remarks></remarks>
        Private Function GetTableName() As String
            Dim myString() As String = Split(Me.QueryString, " ")
            Dim myTableName As String = ""
            Dim intCount As Int16
            For intCount = 0 To myString.Length - 1
                Select Case myString(intCount).ToLower
                    Case "from"
                        myTableName = myString(intCount + 1).ToString
                        Exit For
                End Select
            Next
            Return myTableName
        End Function
        ''' <summary>
        ''' Retorna a cláusula WHERE usada
        ''' </summary>
        ''' <returns></returns>
        ''' <remarks></remarks>
        Private Function GetWhereUsed() As String
            Dim blnStart As Boolean
            Dim myString() As String = Split(Me.QueryString, " ")
            Dim myWhere As String = ""
            Dim intCount As Int16
            For intCount = 0 To myString.Length - 1
                If blnStart = True Then
                    myWhere &= " " & myString(intCount)
                End If
                Select Case myString(intCount).ToLower
                    Case "where"
                        blnStart = True
                    Case "order", "limit"
                        Exit For
                End Select
            Next
            Return myWhere
        End Function
        ''' <summary>
        ''' Comando de adição de registro
        ''' </summary>
        ''' <remarks></remarks>
        Public Sub AddNew()
            blnInsert = True
        End Sub
        ''' <summary>
        ''' Comando de atualização de registro
        ''' </summary>
        ''' <remarks></remarks>
        Public Sub Update()
            Try
                If blnInsert = True Then
                    Call CommitInsert()
                    Call GetSequence()
                Else
                    If blnCloned = True Then
                        Throw New Exception("UPDATE não pode ser executado a partir de clone.")
                    End If
                    Call CommitUpdate()
                End If
            Catch ex As Exception
                Throw New Exception(ex.Message & vbCrLf & CommandExecuted)
            End Try
        End Sub
        ''' <summary>
        ''' Finliza com o processo de inserção dos registros
        ''' </summary>
        ''' <remarks></remarks>
        Private Sub CommitInsert()
            Try
                ' Obtain a new DataRow object from the DataTable.
                Dim drCurrent As DataRow = myDT.NewRow()
                '-- percorrendo colunas
                For intCount As Integer = 0 To arrFields.Count - 1
                    If arrFields(intCount)(2) = True Then
                        '-- autoincremento
                    Else
                        If arrFields(intCount)(5) = True Then
                            drCurrent(arrFields(intCount)(0)) = arrFields(intCount)(6)
                        End If
                    End If
                Next
                '-- Inseridno linha
                myDT.Rows.Add(drCurrent)
                '-- Atualizando
                Dim objCommandBuilder As New SQLiteCommandBuilder(myDA)
                myDA.Update(myDS, Me.TableName)
            Catch exc As SQLiteException
                Throw New Exception(exc.Message)
            Finally

            End Try
        End Sub
        ''' <summary>
        ''' Finaliza o processo de atiualização dos registros
        ''' </summary>
        ''' <remarks></remarks>
        Private Sub CommitUpdate()
            Try
                ' Obtain a new DataRow object from the DataTable.
                Dim drCurrent As DataRow = myDT.NewRow()
                '-- percorrendo colunas
                For intRow As Integer = 0 To myDT.Rows.Count - 1
                    myDT.Rows(intRow).BeginEdit()
                    For intCount As Integer = 0 To arrFields.Count - 1
                        If arrFields(intCount)(2) = False Then
                            If arrFields(intCount)(5) = True Then
                                myDT.Rows(intRow).Item(arrFields(intCount)(0)) = arrFields(intCount)(6)
                            End If
                        End If
                    Next
                    myDT.Rows(intRow).EndEdit()
                Next
                '-- Atualizando
                Dim objCommandBuilder As New SQLiteCommandBuilder(myDA)
                myDA.Update(myDS, Me.TableName)
            Catch exc As SQLiteException
                Throw New Exception(exc.Message)
            Finally

            End Try
        End Sub
        ''' <summary>
        ''' Apaga todos os registros retornados na consulta
        ''' </summary>
        ''' <remarks></remarks>
        Public Sub Delete()
            Try
                ' Obtain a new DataRow object from the DataTable.
                Dim drCurrent As DataRow = myDT.NewRow()
                '-- percorrendo colunas
                For intCount As Integer = 0 To myDT.Rows.Count - 1
                    myDT.Rows(intCount).Delete()
                Next
                '-- Atualizando
                Dim objCommandBuilder As New SQLiteCommandBuilder(myDA)
                myDA.Update(myDS, Me.TableName)
            Catch exc As SQLiteException
                Throw New Exception(exc.Message)
            Finally

            End Try
        End Sub
        ''' <summary>
        ''' Retorna a sequencia atual depois do INSERT ou UPDATE de campos sequenciais
        ''' </summary>
        ''' <remarks></remarks>
        Private Sub GetSequence()
            Try
                Dim strSQL As String = "SELECT seq FROM sqlite_sequence WHERE name='" & Me.TableName & "'"
                ' Create an instance of a DataAdapter.
                Dim daResgister As New SQLiteDataAdapter(strSQL, myConnection)
                ' Create an instance of a DataSet, and retrieve data from the Authors table.
                Dim dsRsgister As New DataSet(Me.TableName)
                daResgister.FillSchema(dsRsgister, SchemaType.Source, Me.TableName)
                daResgister.Fill(dsRsgister, Me.TableName)
                ' Create a new instance of a DataTable.
                Dim tblTemp As DataTable = dsRsgister.Tables(Me.TableName)
                '-- percorrendo colunas
                For intCount As Integer = 0 To arrFields.Count - 1
                    If arrFields(intCount)(2) = True Then
                        arrFields(intCount)(6) = tblTemp.Rows(0).Item("seq")
                    End If
                Next
            Catch exc As SQLiteException
                Throw New Exception(exc.Message)
            Finally

            End Try
        End Sub
        ''' <summary>
        ''' Define que o RecordSet trabalhará como clonagem
        ''' </summary>
        ''' <remarks></remarks>
        Public Sub Clone()
            Dim intCount As Int16
            For intCount = 0 To arrFields.Count - 1
                arrFields(intCount)(5) = True
            Next
            blnCloned = True
        End Sub
        ''' <summary>
        ''' Ignora campo ao inserir ou atualizar os dados, dando-o como não alterado.
        ''' </summary>
        ''' <param name="FieldName"></param>
        ''' <remarks></remarks>
        Public Sub Supress(ByVal FieldName As String)
            Dim intCount As Int16
            For intCount = 0 To arrFields.Count - 1
                If arrFields(intCount)(0) = FieldName Then
                    arrFields(intCount)(5) = False
                    Exit Sub
                End If
            Next
        End Sub

        Public Sub CompactDatabase()
            Dim Query As String = "VACUUM;"
            Try
                'Dim myCA As New SQLiteCommand(Query, myConnection)
            Catch exc As SQLiteException
                Throw New Exception(exc.Message & vbCrLf & Query)
            End Try
        End Sub
    End Class
End Class
